(:~
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 :     http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :
 : @author David Steiner
 : @version 0.9
 :
 :)
xquery version "1.0-ml";

module namespace tx="http://txhelper.org/tx";

declare default function namespace "http://www.w3.org/2005/xpath-functions";
declare boundary-space preserve;
declare option xdmp:mapping "false";

declare function tx:docs() { for $doc in tx:_docs()/txdata return $doc };
declare function tx:docs($newNodes) { tx:_docs($newNodes) };

declare function tx:status() { element status { tx:_docs() } };

declare function tx:commit() { tx:_commit(tx:_docs()) };
declare function tx:abort() { xdmp:set($abortTransaction, true()) };
declare function tx:clear() { map:clear($alltxdocs) };

declare function tx:base-uri($node) { (base-uri($node), $node/ancestor-or-self::txdoc/@txuri)[1] };

declare function tx:document-insert($uri as xs:string,$doc) { tx:document-insert($uri, $doc, (), (), ()) };
declare function tx:document-insert($uri as xs:string,$doc,$permissions) { tx:document-insert($uri, $doc, $permissions, (), ()) };
declare function tx:document-insert($uri as xs:string,$doc,$permissions,$collections) { tx:document-insert($uri, $doc, $permissions, $collections, ()) };
declare function tx:document-insert($uri as xs:string,$doc,$permissions,$collections,$quality) { tx:_replace-txdoc(tx:_new-txdoc($uri,$doc,$permissions,$collections,$quality,true(),false(),false())) };

declare function tx:document-delete($urisOrDocs) { for $txroot in  tx:_roots($urisOrDocs) return tx:_replace-txdoc($txroot,true()) };

declare function tx:node-insert-child($parentNode as element(), $newNode as node()*) as node() { tx:_replace-txdoc(tx:_node-insert-child(tx:docs($parentNode), $newNode)) };
declare function tx:node-insert-before($sibling as node(), $newNode as node()* ) as node() { tx:_replace-txdoc(tx:_node-insert-before(tx:docs($sibling), $newNode)) };
declare function tx:node-insert-after(	$sibling as node(), 	$newNode as node()* ) as node() { tx:_replace-txdoc(tx:_node-insert-after(tx:docs($sibling), $newNode)) };
declare function tx:node-replace(	$goneNodes as node()*, 	$newNode as node() ) as node() { tx:_replace-txdoc(tx:_node-replace(tx:docs($goneNodes), $newNode)) };
declare function tx:node-delete($goneNodes as node()* ) as node()? { if($goneNodes) then tx:_replace-txdoc(tx:_node-delete(tx:docs($goneNodes))) else () };
declare function tx:node-replace-or-insert-child($goneNodes as node()*, $parentNode as element(), $newNode as node()* ) as node() { tx:_replace-txdoc(tx:_node-replace-or-insert-child(tx:docs($goneNodes), tx:docs($parentNode), $newNode)) };

declare function tx:document-get-collections($urisOrDocs) { 	for $txroot in tx:_roots($urisOrDocs) return tokenize($txroot/@collections,',') };
declare function tx:document-set-collections($urisOrDocs,$collections) { for $txroot in tx:_roots($urisOrDocs) return tx:_replace-txdoc(tx:_node-replace-or-insert-child($txroot/@collections, $txroot, attribute collections { tx:_strings2orderedString($collections) } )) }; 
declare function tx:document-add-collections($urisOrDocs,$collections) { for $txroot in tx:_roots($urisOrDocs) return tx:_replace-txdoc(tx:_node-replace-or-insert-child($txroot/@collections, $txroot, attribute collections { tx:_strings2orderedString((tokenize($txroot/@collections,','),$collections))})) };
declare function tx:document-remove-collections($urisOrDocs,$patterns as xs:string*) { tx:_document-remove-collections($urisOrDocs,$patterns) };

declare function tx:document-get-quality($urisOrDocs) { 	for $txroot in tx:_roots($urisOrDocs) return try { xs:integer($txroot/@quality) } catch($x) { 0 } };
declare function tx:document-set-quality($urisOrDocs,$quality as xs:integer) { for $txroot in tx:_roots($urisOrDocs) return tx:_replace-txdoc(tx:_node-replace-or-insert-child($txroot/@qualitiy, $txroot, attribute quality { $quality } )) };

declare function tx:document-get-permissions($urisOrDocs) { for $txroot in tx:_roots($urisOrDocs) return $txroot/permissions/* };
declare function tx:document-set-permissions($urisOrDocs,$permissions as element(sec:permission)*) { for $txroot in tx:_roots($urisOrDocs) return tx:_replace-txdoc(tx:_node-replace-or-insert-child($txroot/permissions, $txroot, element permissions { $permissions } )) };
declare function tx:document-add-permissions($urisOrDocs,$permissions as element(sec:permission)*) { for $txroot in tx:_roots($urisOrDocs) return tx:_replace-txdoc(tx:_node-replace-or-insert-child($txroot/permissions, $txroot, element permissions { ($txroot/permissions/sec:*,$permissions) } )) };
declare function tx:document-remove-permissions($urisOrDocs,$permissions as element(sec:permission)*) { tx:_document-remove-permissions($urisOrDocs,$permissions) };

declare function tx:document-set-options($urisOrDocs,$options as element(options)?) { for $txroot in tx:_roots($urisOrDocs) return tx:_replace-txdoc(tx:_node-replace-or-insert-child($txroot/options,$txroot, $options)) };

declare function tx:save($path as xs:string, $node as node()) { tx:_save($path, $node) };
declare function tx:filesystem-file($path as xs:string) { tx:_filesystem-file($path) };
declare function tx:filesystem-zero($path as xs:string) { tx:_filesystem-zero($path) };

declare variable $DEFAULT_OPTIONS := 
	<options>
		<createAncestorDirectories/>
		<useAncestorPermissions/>
	</options>;

(: Currently not implemented 
declare function tx:document-get-properties($urisOrDocs) {};
declare function tx:document-set-properties($urisOrDocs,$properties as element()* ) {};
declare function tx:document-add-properties($urisOrDocs,$properties as element()* ) {};
declare function tx:document-remove-properties($urisOrDocs,$properties as xs:QName*) {};
:)

(:======================= Private functions ========================:)

declare variable $alltxdocs := map:map();
declare variable $abortTransaction := false();

declare function tx:_docs() { for $key in map:keys($alltxdocs) return map:get($alltxdocs,$key) }; 

declare function tx:_docs($newNodes) { 
	for $d in $newNodes
	return
		if($d instance of xs:string) 
		then tx:docs(xdmp:value($d))
		else tx:_wrap((),$d,false(),false(),false())
};

declare function tx:_urisOrDocs($urisOrDocs) { 
	for $uod in $urisOrDocs 
	let $isString := ($uod instance of xs:string) or ($uod instance of xs:anyURI)
	return 
		if($isString) 
		then 
			let $currentVersion := map:get($alltxdocs, $uod)
			return if($currentVersion) then $currentVersion/txdata/node() else tx:docs(doc($uod)) 
		else tx:docs($uod)
};

declare function tx:_roots($urisOrDocs) {
	for $doc in tx:_urisOrDocs($urisOrDocs) return root($doc)
};

declare function tx:_wrap($uri,$node,$modified,$deleted,$filesystem) {
	let $uri := xs:string(($uri,$node/ancestor-or-self::txdoc/@txuri,base-uri($node),concat('^',xdmp:random()))[1])
	let $currentVersion := map:get($alltxdocs, $uri)
	let $root := root($node)
	let $istxdoc := local-name($root) = 'txdoc'
	let $ret := 
		if(exists($currentVersion))
		then 
			if($root is $currentVersion) 
			then $node
			else 
				let $path := xdmp:path($node)
				let $path := if(starts-with($path,'/txdoc')) then substring($path,7) else $path
				let $path := if($path = '/') then '' else $path
				let $expr := concat('$currentVersion',if($istxdoc) then '' else '/txdata',$path)
			    let $r := xdmp:value($expr)
				return $r
		else
			let $txdoc := tx:_new-txdoc($uri,$root,(),(),(),$modified,$deleted,$filesystem)
			let $putInTransaction := map:put($alltxdocs,xs:string($txdoc/@txuri),$txdoc)
			let $path := concat('$txdoc/txdata',xdmp:path($node))
			let $path := if(ends-with($path,'/')) then concat($path,'node()') else $path
			return xdmp:value($path)
	return $ret
};

declare function tx:_strings2orderedString($strings) { string-join(for $s in distinct-values($strings) order by $s return $s,',') };

declare function tx:_new-txdoc($uri,$doc,$permissions,$collections,$quality,$modified,$deleted,$filesystem) {
	element txdoc { 
		if($modified or $deleted) then attribute modified { 'true' } else (),
		if($deleted) then attribute deleted { 'true' } else (),
		attribute txuri { $uri },
		attribute ver { xdmp:random() }, (: take this out someday :)
		if(starts-with($uri, "^")) then () else
		(
			attribute collections{ tx:_strings2orderedString(if($collections) then $collections else xdmp:document-get-collections($uri)) },
			attribute quality { if($quality) then $quality else xdmp:document-get-quality($uri) },
			element permissions { if($permissions) then $permissions else xdmp:document-get-permissions($uri) }
		),
		element txdata { $doc }
	}
};

declare function tx:_replace-txdoc($txdoc) { tx:_replace-txdoc($txdoc,false()) };
declare function tx:_replace-txdoc($txdoc,$deleted) {
	let $uri := xs:string($txdoc/@txuri)
	let $old := map:get($alltxdocs,$uri)
	let $rebuild := 
		element txdoc {
			$txdoc/@* except ($txdoc/@deleted,$txdoc/@ver,$txdoc/@oldver,$txdoc/@filesystem),
			if($txdoc/@modified) then () else attribute modified { 'true' },
			if($deleted) then attribute deleted { 'true' } else (),
			if($txdoc/@filesystem) then attribute filesystem { 'true' } else (),
			attribute ver { xdmp:random() }, (: take this out someday :)
			attribute oldver { $txdoc/@ver }, (: take this out someday :)
			$txdoc/node()
		}
 	let $replace := map:put($alltxdocs,$uri,$rebuild)
	let $b := tx:break()
 	return $rebuild/txdata/node()
};

declare function tx:_document-remove-collections($urisOrDocs,$patterns as xs:string*) {
	if($patterns)
	then
		let $roots := tx:_roots($urisOrDocs)
		for $txroot in $roots
		return
			let $newCollections := tx:_strings2orderedString( 
				for $col in tokenize(fn:string($txroot/@collections),',')
				let $matches := sum(for $pattern in $patterns return if(matches($col,$pattern)) then 1 else 0) > 0  
				return if($matches) then () else $col
			)
			let $oldCollections := fn:string($txroot/@collections)
			return
				if($newCollections eq $oldCollections) 
				then $txroot 
				else tx:_replace-txdoc(tx:_node-replace-or-insert-child($txroot/@collections, $txroot, attribute collections { $newCollections }))
	else $urisOrDocs
};

declare function tx:_save($path as xs:string, $node as node()) { tx:_replace-txdoc(tx:_new-txdoc($path,$node,(),(),(),true(),false(),true())) };
declare function tx:_filesystem-zero($path as xs:string) { tx:_replace-txdoc(tx:_new-txdoc($path,(),(),(),(),true(),true(),true())) };
declare function tx:_filesystem-file($path as xs:string) { tx:_replace-txdoc(tx:_new-txdoc($path,xdmp:filesystem-file($path),(),(),(),false(),false(),true())) };

declare function tx:_commit($txdocs) {
	let $commit := 
		element commit {
			if($abortTransaction) 
			then <commitAborted/> 
			else
			for $txdoc in $txdocs
			let $uri := string($txdoc/@txuri)
			return
				if(($txdoc/@modified or $txdoc/@delete) and (string-length($uri) > 0) and not(starts-with($uri,'^')))
				then 
					if($txdoc/@deleted)
						then 
							let $delete := 
								if($txdoc/@filesystem) 
								then xdmp:save($uri, binary{ xdmp:base64-encode(xs:string("")) }) (: Cannot delete so zero it out :)
								else xdmp:document-delete($uri)
							return element committed { $txdoc/@deleted, $txdoc/@txuri } 
						else
							if($txdoc/@filesystem) 
							then 
								let $doc := document{$txdoc/txdata/node()}
								let $save := xdmp:save($uri, $doc)
								return element committed { $txdoc/@deleted, $txdoc/@txuri }
							else 
								let $permissions := $txdoc/permissions/*
								let $permissions := if($permissions) then $permissions else xdmp:default-permissions($uri)
								let $collections := fn:tokenize($txdoc/@collections,',')
								let $quality := try { xs:integer($txdoc/@quality) } catch($x) { 0 }
								let $doc := document{$txdoc/txdata/node()}
								let $docOptions := ($txdoc/options,$DEFAULT_OPTIONS)[1]
								let $ancestorPermissions := if($docOptions/createAncestorDirectories) then tx:_createAncestorDirectories($uri) else ()
								let $permissions := ($permissions,if($docOptions/useAncestorPermissions) then $ancestorPermissions else ())
								let $insert := xdmp:document-insert($uri, $doc, $permissions, $collections, $quality)
								return element committed { $txdoc/@deleted, $txdoc/@txuri }
					else ()
		}
	let $clear := tx:clear()
	return $commit
};

declare function tx:_createAncestorDirectories($uri) as element(sec:permissions)* {
	let $steps := tokenize($uri,'/')
	let $count := count($steps)
	let $dirs :=
		for $dir at $i in $steps
		return if($i < $count) then string-join((subsequence($steps,1,$i),''),'/') else ()
	return tx:_createAncestorDir($dirs,())
};

declare function tx:_createAncestorDir($uris,$permissions) {
	if($uris[1]) then $permissions 
	else if(try { (xdmp:directory-create($uris[1],$permissions), true())} catch($x) { false() })
	then tx:_createAncestorDir(subsequence($uris,2),$permissions)
	else if($uris[1]) then tx:_createAncestorDir(subsequence($uris,2),xdmp:document-get-permissions($uris[1]))
	else ()
};

declare function tx:_document-remove-permissions($urisOrDocs,$permissions as element(sec:permission)*) {
	for $txroot in tx:_roots($urisOrDocs) 	
	return
		tx:_replace-txdoc(
			tx:_node-replace-or-insert-child($txroot/permissions, $txroot,
				element permissions {
					for $out in $txroot/permissions/*
					return 
						if(exists($permissions[sec:role-id = $out/sec:role-id][sec:capability = $out/sec:capability]))
						then ()
						else $out
				}
			)
		)
};

declare function tx:_rollback($txdocs) { error('UNIMPLEMENTED') };

(:======================= debugging functions ========================:)

declare variable $break := false();
declare function tx:break() { if($break) then error() else () };
declare function tx:break($v as xs:boolean) { xdmp:set($break,$v) };

(:======================= in-memory node functions ========================:)
(:~
 :
 : Based on some functions Copyright 2007 Ryan Grimm
 :
 : A module to update in memory nodes.  These function are intended to
 : mirror the built in update function (eg: xdmp:node-insert-child).
 : One difference between these functions and the built in update functions
 : is that the new node can actually be a sequence of nodes.  It is
 : recommended to use this feature as much as possible for performance
 : reasons.  Another difference is that these functions return the
 : modified XML back to you.
 :
 : Note: Functions that start with an underscore are private functions.
 :
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 :     http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :
 : Ported to XQuery 1.0, November 2008.
 :
 : @author Ryan Grimm (grimm@xqdev.com)
 : @version 0.2
 :
 :)


declare function tx:_node-insert-child($parentNode as element(), $newNode as node()* ) as node() { tx:_process(root($parentNode), $parentNode, $newNode, "insert-child") };
declare function tx:_node-insert-before($sibling as node(), $newNode as node()* ) as node() { tx:_process(root($sibling), $sibling, $newNode, "insert-before") };
declare function tx:_node-insert-after($sibling as node(), $newNode as node()* ) as node() { tx:_process(root($sibling), $sibling, $newNode, "insert-after") };
declare function tx:_node-replace($goneNodes as node()*, $newNode as node() ) as node() { 	tx:_process(root($goneNodes[1]), $goneNodes, $newNode, "delete") };
declare function tx:_node-delete($goneNodes as node()* ) as node()? { tx:_process(root($goneNodes[1]), $goneNodes, (), "delete") };
declare function tx:_node-replace-or-insert-child($goneNodes as node()*, $parentNode as element(), $newNode as node()* ) as node() {
			if($goneNodes) 
			then tx:_node-replace($goneNodes, $newNode)
			else  tx:_node-insert-child($parentNode, $newNode)
};


(:
	Processes an element.  Elements that match one of the modifier nodes are
	handeled depending on the mode.  Don't feel bad if you don't quite
	understand this code.
:)
declare function tx:_process(	$node as node(), $modifierNodes as node()*, $newNode as node()*, $mode as xs:string) as node()* {
	let $matches := sum(
		for $gone in $modifierNodes
		return if($node is $gone) then 1 else 0
	)
	return
		if($mode = "delete")
		then
			if($matches > 0)
			then $newNode
			else tx:_processNode($node, $modifierNodes, $newNode, $mode)
		else if($mode = "insert-child")
		then
			if($matches > 0)
			then element { QName(namespace-uri($node), local-name($node)) } { 
					if(xdmp:node-kind($newNode) = 'attribute')
					then (($node/@* except xdmp:value(fn:concat('$node/@',local-name($newNode)))), $newNode, $node/node())
					else ($node/@*, $node/node(), $newNode) 
			}
			else tx:_processNode($node, $modifierNodes, $newNode, $mode)
		else if($mode = "insert-after")
		then
			if($matches > 0)
			then ($node, $newNode)
			else tx:_processNode($node, $modifierNodes, $newNode, $mode)
		else if($mode = "insert-before")
		then
			if($matches > 0)
			then ($newNode, $node)
			else tx:_processNode($node, $modifierNodes, $newNode, $mode)
		else ()
};

(:
	Constructs a node if need be and processes all of its children
:)
declare function tx:_processNode($node as node(), $modifierNodes as node()*, $newNode as node()*, $mode as xs:string ) as node() {
	if($node instance of element(*))
	then element { QName(namespace-uri($node), local-name($node)) } {
		for $child in ($node/@*, $node/node())
        return tx:_process($child, $modifierNodes, $newNode, $mode)
 	}
	else $node
};

declare function tx:_replaceAllNodes($doc,$finder,$replacement) {
	let $node := xdmp:value($finder)[1]
	return
		if($node)
		then tx:_replaceAllNodes(tx:_node-replace($node,xdmp:value($replacement)),$finder,$replacement)
		else $doc
};

declare function tx:_insertAfterAllNodes($doc,$finder,$addition) {
	let $node := xdmp:value($finder)[1]
	return
		if($node)
		then tx:_replaceAllNodes(tx:_node-insert-after($node,xdmp:value($addition)),$finder,$addition)
		else $doc
};

